home *** CD-ROM | disk | FTP | other *** search
/ Creative Computers / Creative Computers CD-ROM, Volume 1 (Legendary Design Technologies, Inc.)(1994).iso / shareware / fractals / ffex / source / ffex.mod < prev    next >
Text File  |  1994-11-17  |  18KB  |  526 lines
  1. (* Modul    : FFEX                             *)
  2. (* Projekt  : FFEX (Fast Fractal Exploration Set)             *)
  3. (* Autor    : Robert Brandner                         *)
  4. (* Funktion : Hauptmodul von FFEX - Menüabfragen, Zoom, Berechnungen ... *)
  5. (* Copyright: Robert Brandner                         *)
  6. (*          Schillerstr. 3                         *)
  7. (*          A-8280 Fürstenfeld                     *)
  8. (*          AUSTRIA                             *)
  9.  
  10. MODULE FFEX;
  11.  
  12. FROM Menu      IMPORT SetMenu, MenuNum, ItemNum, SubNum, NextSelect;
  13. FROM Render    IMPORT SetPixel,GetPixel,FastIter16,FastIter32,LongRealIter,
  14.                       SetNormalPointer,SetZZZPointer,SetZoomPointer;
  15. FROM Request   IMPORT Info, GetLimits, Request;
  16. FROM ArpReq    IMPORT GetFileName;
  17. FROM IlbmInOut IMPORT LoadILBM, SaveILBM;
  18.  
  19. FROM Arts      IMPORT Assert, TermProcedure;
  20. FROM SYSTEM    IMPORT ADR, ADDRESS, CAST, INLINE, LONGSET;
  21. FROM GfxMacros IMPORT RasSize;
  22. FROM Graphics  IMPORT ViewModes,ViewModeSet,FontFlags,FontFlagSet,
  23.                       TextFontPtr, OpenFont,normalFont,TextAttr,CloseFont,
  24.                       LoadRGB4, SetRGB4, RastPortPtr,RectFill,SetAPen,
  25.                       SetRast, Move, Draw, SetDrMd, DrawModeSet,DrawModes,
  26.                       jam1, BltBitMap;
  27. FROM Intuition IMPORT IntuiMessagePtr, menuNull, ShowTitle, ModifyIDCMP,
  28.                 ScreenPtr,NewScreen,OpenScreen,CloseScreen,
  29.               WindowPtr,NewWindow,OpenWindow,CloseWindow,
  30.               WindowFlags,WindowFlagSet,ScreenFlags,ScreenFlagSet,
  31.               customScreen, IDCMPFlagSet, IDCMPFlags, ScreenToFront,
  32.               ClearMenuStrip, menuDown, menuUp, selectDown, selectUp;
  33. FROM Exec      IMPORT FindTask, TaskPtr, GetMsg, ReplyMsg, WaitPort, CopyMem;
  34. FROM Dos       IMPORT ProcessPtr;
  35.  
  36. CONST
  37.   SCREENTITLE="Fast Fractal Exploration Set 4.0";
  38.   TOPAZ="topaz.font";
  39.   LIMIT=4; (* bis zu dieser Größe werden Rechtecke gevierte(i)lt *)
  40.   ESCAPE=045H;
  41.   MENUFLAGS=IDCMPFlagSet{menuVerify,menuPick,mouseButtons};
  42.   STARTPIC="FFEXStart.pic";
  43.  
  44. TYPE
  45.   IterProc=PROCEDURE(LONGREAL,LONGREAL,LONGINT):LONGINT;
  46.  
  47. VAR
  48.   ns        : NewScreen;
  49.   nw        : NewWindow;
  50.   Iterations: IterProc;
  51.   win       : WindowPtr;
  52.   scr       : ScreenPtr;
  53.   topaz80   : TextFontPtr;
  54.   attr      : TextAttr;
  55.   thisTask  : ProcessPtr;
  56.   QUIT,title: BOOLEAN;
  57.   yadr      : ARRAY[0..512] OF LONGINT;
  58.   rp        : RastPortPtr;
  59.   msg       : IntuiMessagePtr;
  60.   class     : IDCMPFlagSet;
  61.   code      : CARDINAL;
  62.   xres,yres,depth,i,maxcol: INTEGER;
  63.   xmin,ymin,xmax,ymax     : LONGREAL; (* Koord. des zu zeichnenden Bildes *)
  64.   xminr,yminr,xmaxr,ymaxr : LONGREAL; (* Koord. des letzten gez. Bildes *)
  65.   x1,y1,x2,y2             : LONGREAL; (* Hilfsvariablen *)
  66.   maxiter                 : LONGINT;
  67.   zx,zy,zdx,zdy           : INTEGER;  (* Zoomrahmen *)
  68.   fileok    : BOOLEAN;
  69.   fname     : ARRAY[0..255] OF CHAR;  (* für Filerequester *)
  70.   saved     : BOOLEAN;
  71.   mess      : ARRAY[0..80] OF CHAR;
  72.   no,yes    : ARRAY[0..9] OF CHAR;
  73.  
  74. PROCEDURE TextColorsOn; FORWARD;
  75. PROCEDURE TextColorsOff; FORWARD;
  76. PROCEDURE CreateDisplay(w,h,d:INTEGER); FORWARD;
  77.  
  78. PROCEDURE LoadIff(fn:BOOLEAN);
  79.   VAR
  80.     i,planebytes,ok:LONGINT;
  81.     lscr:ScreenPtr;
  82.   BEGIN
  83.     IF NOT saved THEN
  84.       mess:="This picture is not saved!|If you continue, it will be lost!";
  85.       yes:="CONTINUE"; no:="CANCEL";
  86.       IF NOT Request(win,mess,yes,no) THEN RETURN END;
  87.     END;
  88.     INCL(win^.flags,rmbTrap);
  89.     ModifyIDCMP(win,IDCMPFlagSet{});
  90.     IF fn THEN
  91.       TextColorsOn;
  92.       fileok:=GetFileName(win,ADR("Load File"),ADR(fname));
  93.       TextColorsOff;
  94.     ELSE
  95.       fileok:=TRUE
  96.     END;
  97.     IF fileok THEN
  98.       SetZZZPointer(win);
  99.       fileok:=LoadILBM(fname,win,lscr,xminr,yminr,xmaxr,ymaxr,maxiter);
  100.       IF fileok THEN
  101.         xmin:=xminr; ymin:=yminr; xmax:=xmaxr; ymax:=ymaxr;
  102.         IF (lscr^.width#xres) OR (lscr^.height#yres) THEN
  103.           CreateDisplay(lscr^.width,lscr^.height,INTEGER(lscr^.bitMap.depth));
  104.         END;
  105.         saved:=TRUE;
  106.         ShowTitle(scr,FALSE);
  107.         ok:=BltBitMap(ADR(lscr^.bitMap),0,0,ADR(scr^.bitMap),0,0,
  108.                       xres,yres,0C0H,0FFH,NIL);
  109.         ShowTitle(scr,title);
  110.         CloseScreen(lscr);
  111.       END;
  112.       SetNormalPointer(win);
  113.     END;
  114.     EXCL(win^.flags,rmbTrap);
  115.     ModifyIDCMP(win,MENUFLAGS);
  116.   END LoadIff;
  117.  
  118. PROCEDURE SaveIff;
  119.   BEGIN
  120.     ClearMenuStrip(win);
  121.     ModifyIDCMP(win,IDCMPFlagSet{});
  122.     TextColorsOn;
  123.     fileok:=GetFileName(win,ADR("Save File"),ADR(fname));
  124.     TextColorsOff;
  125.     IF fileok THEN
  126.       INCL(win^.flags,rmbTrap);
  127.       SetZZZPointer(win); ShowTitle(scr,FALSE);
  128.       fileok:=SaveILBM(fname,scr,xminr,yminr,xmaxr,ymaxr,maxiter);
  129.       saved:=fileok;
  130.       SetNormalPointer(win); ShowTitle(scr,title); EXCL(win^.flags,rmbTrap);
  131.     END;
  132.     ModifyIDCMP(win,MENUFLAGS);
  133.     SetMenu(win);
  134.   END SaveIff;
  135.  
  136. (*** Prozeduren für Screen und Window ********************************)
  137.  
  138. PROCEDURE ColorTable; (* $E- *)
  139.   BEGIN
  140.     INLINE(00000H,00FF0H,00FD0H,00FB0H,00F80H,00F60H,00F40H,00F20H,
  141.        00F00H,00F02H,00F05H,00F07H,00F09H,00F0BH,00F0DH,00F0FH,
  142.        00D0FH,00B0FH,0090FH,0070FH,0050FH,0030FH,0010FH,0001FH,
  143.        0003FH,0005FH,0007FH,0009FH,000BFH,000DFH,000FFH,00DDDH);
  144.   END ColorTable;
  145.  
  146.  
  147. PROCEDURE CloseIfOpen;
  148.   BEGIN
  149.     thisTask:=CAST(ProcessPtr,FindTask(NIL));
  150.     thisTask^.windowPtr:=NIL;
  151.     IF win#NIL THEN CloseWindow(win); win:=NIL END;
  152.     IF scr#NIL THEN CloseScreen(scr); scr:=NIL END;
  153.   END CloseIfOpen;
  154.  
  155.  
  156. PROCEDURE CreateDisplay(w,h,d:INTEGER);
  157.   BEGIN
  158.     xres:=w; yres:=h; depth:=d; (* Werte für DrawFractal/Zoom merken *)
  159.     IF NOT saved THEN
  160.       mess:="This picture is not saved!|If you continue, it will be lost!";
  161.       yes:="CONTINUE"; no:="CANCEL";
  162.       IF NOT Request(win,mess,yes,no) THEN RETURN END;
  163.     END;
  164.     CloseIfOpen;
  165.     WITH ns DO
  166.       width:=w; height:=h; depth:=d; detailPen:=6; blockPen:=1;
  167.       viewModes:=ViewModeSet{};
  168.       IF w>320 THEN INCL(viewModes,hires) END;
  169.       IF h>256 THEN INCL(viewModes,lace) END;
  170.       type:=customScreen+ScreenFlagSet{screenBehind};
  171.       font:=ADR(attr); defaultTitle:=ADR(SCREENTITLE);
  172.       gadgets:=NIL; customBitMap:=NIL;
  173.     END;
  174.     scr:=OpenScreen(ns);
  175.     Assert(scr#NIL,ADR("OpenScreen() failed!"));
  176.     LoadRGB4(ADR(scr^.viewPort),ADR(ColorTable),32);
  177.     IF d=5 THEN maxcol:=31 ELSE maxcol:=15 END;
  178.     WITH nw DO
  179.       width:=w; height:=h; detailPen:=3; blockPen:=1;
  180.       idcmpFlags:=IDCMPFlagSet{menuVerify, menuPick, mouseButtons};
  181.       flags:=WindowFlagSet{reportMouse,backDrop,borderless,
  182.                            activate,noCareRefresh};
  183.       firstGadget:=NIL;checkMark:=NIL;title:=NIL;
  184.       screen:=scr; bitMap:=NIL;
  185.       minWidth:=0; minHeight:=0; maxWidth:=-1; maxHeight:=-1;
  186.       type:=customScreen;
  187.     END;
  188.     win:=OpenWindow(nw);
  189.     Assert(win#NIL,ADR("OpenWindow() failed!"));
  190.     rp:=win^.rPort;
  191.     FOR i:=0 TO h-1 DO  (* Zeilenadressen berechnen      *)
  192.       yadr[i]:=LONGINT(i)*LONGINT(rp^.bitMap^.bytesPerRow);
  193.     END;
  194.     ScreenToFront(scr);
  195.     thisTask:=CAST(ProcessPtr,FindTask(NIL)); (* Systemrequester auf *)
  196.     thisTask^.windowPtr:=win;              (* eigenem Screen.     *)
  197.     SetMenu(win);
  198.     title:=TRUE; ShowTitle(scr,title);
  199.   END CreateDisplay;
  200.  
  201.  
  202. (*** Prozeduren für Fraktalgrafik ************************************)
  203.  
  204. PROCEDURE DrawFractal(rmin,rmax,imin,imax:LONGREAL;
  205.               maxcol:INTEGER;
  206.               maxiter:LONGINT);
  207. VAR
  208.   r,cxr,cyr,dxr,dyr:LONGREAL;
  209.   lc:LONGINT;
  210.   exit:BOOLEAN;
  211.  
  212. PROCEDURE HLine(xmin,xmax,y:INTEGER); (* waagrechte Linie *)
  213. BEGIN
  214.   cxr:=rmin+LONGREAL(xmin)*dxr;cyr:=imin+LONGREAL(y)*dyr;
  215.   FOR i:=xmin TO xmax DO
  216.     lc:=Iterations(cxr,cyr,maxiter);cxr:=cxr+dxr;
  217.     SetPixel(i,yadr[y],lc,maxiter,maxcol,ADR(rp^.bitMap^.planes[0]));
  218.   END
  219. END HLine;
  220.  
  221. PROCEDURE VLine(ymin,ymax,x:INTEGER); (* senkrechte Linie *)
  222. BEGIN
  223.   cxr:=rmin+LONGREAL(x)*dxr;cyr:=imin+LONGREAL(ymin)*dyr;
  224.   FOR i:=ymin TO ymax DO
  225.     lc:=Iterations(cxr,cyr,maxiter);cyr:=cyr+dyr;
  226.     SetPixel(x,yadr[i],lc,maxiter,maxcol,ADR(rp^.bitMap^.planes[0]));
  227.   END
  228. END VLine;
  229.  
  230. PROCEDURE Rectangle(xmin,ymin,xmax,ymax:INTEGER);
  231.   VAR
  232.     eq:BOOLEAN;
  233.     dx2,dy2,k:INTEGER;
  234.   BEGIN
  235.     IF exit THEN RETURN END;
  236.     msg:=GetMsg(win^.userPort);
  237.     IF msg#NIL THEN
  238.       ReplyMsg(msg);
  239.       IF msg^.code=ESCAPE THEN exit:=TRUE END;
  240.     END;
  241.     dx2:=(xmax-xmin);dy2:=(ymax-ymin);
  242.